home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 42 / Amiga Format AFCD42 (Issue 126, Aug 1999).iso / -serious- / programming / other / wild / support / metaedit.bas < prev    next >
BASIC Source File  |  1999-05-25  |  11KB  |  505 lines
  1. SCREEN 1,720,455,2,5
  2. WINDOW 1,"METAEdit ...",(0,0)-(640,400),,1
  3. PALETTE 0,.6,.7,.8
  4. PALETTE 1,0,0,0
  5. PALETTE 2,1,1,1
  6. PALETTE 3,1,.8,.2
  7. DIM DotWM$(3)
  8. DotWM$(DOTX%)="x"
  9. DotWM$(DOTY%)="y"
  10. DotWM$(DOTZ%)="z"
  11. MAXDOTMAP%=3
  12. DIM EdgeWM$(2)
  13. EdgeWM$(EDGPA%)="pa"
  14. EdgeWM$(EDGPB%)="pb"
  15. MAXEDGMAP%=2
  16. DIM FaceWM$(15)
  17. FaceWM$(FACPA%)="pa"
  18. FaceWM$(FACPB%)="pb"
  19. FaceWM$(FACPC%)="pc"
  20. FaceWM$(FACLA%)="la"
  21. FaceWM$(FACLB%)="lb"
  22. FaceWM$(FACLC%)="lc"
  23. FaceWM$(FACPLUS%)="plus"
  24. FaceWM$(FACMINUS%)="minus"
  25. FaceWM$(FACTXA%)="txa"
  26. FaceWM$(FACTXB%)="txb"
  27. FaceWM$(FACTXC%)="txc" 
  28. FaceWM$(FACTYA%)="tya"
  29. FaceWM$(FACTYB%)="tyb"
  30. FaceWM$(FACTYC%)="tyc"
  31. FaceWM$(FACTEX%)="tex"
  32. MAXFACMAP%=15
  33. DIM TexWM$(11)
  34. TexWM$(TEXFILE%)="file"
  35. TexWM$(TEXPALETTE%)="palette"
  36. TexWM$(TEXSIZEX%)="sizex"
  37. TexWM$(TEXSIZEY%)="sizey"
  38. MAXTEXMAP%=11
  39.  
  40. '$INCLUDE BASU:_Cut.bas
  41. '$INCLUDE BASU:_NumInt.bas
  42. '$INCLUDE BASU:_Command.bas
  43. '$INCLUDE BASU:_METAConsts.bas
  44. '$INCLUDE BASU:_CutWord.bas
  45. '$INCLUDE BASU:_LoadMETA.bas
  46. '$INCLUDE BASU:_Prox.bas
  47. '$INCLUDE BASU:_SafeLine.bas
  48. '$INCLUDE BASU:_METAViewTD.bas
  49. '$INCLUDE BASU:_WAITKEY.bas
  50. '$INCLUDE BASU:_CutSpace.bas
  51. '$INCLUDE BASU:_CommandInput.bas
  52. '$INCLUDE BASU:_Contain.bas
  53. '$INCLUDE BASU:_SaveMETA.bas
  54. '$INCLUDE BASU:_SuperPrint.bas
  55. '$INCLUDE BASU:_FileReq.bas
  56. '$INCLUDE BASU:_LoadPalette.bas
  57. '$INCLUDE BASU:_WAITHIT.bas
  58.  
  59. viewmode&=VIEWMODE_WIRE&+VIEWFLAG_SELSHOW&+VIEWFLAG_SELNORM&+VIEWFLAG_SHOWFACES&+VIEWFLAG_SHOWPNTS&+VIEWFLAG_SELPNTS&
  60. CurFace=1:CurTexture=1
  61. METAIN$=FileReq$("WildPJ:Support/META/","Select META input...","#?.META")
  62. LoadMETA(METAIN$)
  63.  
  64. FOR i=1 TO 12
  65.  READ ObjRef(i)
  66. NEXT i
  67. GOSUB Refresh
  68. WINDOW 2,"Console...",(210,20)-(410,100),,1
  69. REPEAT cons
  70.  WINDOW OUTPUT 1
  71.  LOCATE 1,1
  72.  COLOR 2,1
  73.  PRINT "CF:";CurFace,"CTX";CurTexture
  74.  WINDOW OUTPUT 2
  75.  CALL CommandInput
  76.  SELECT CASE CM$
  77.   CASE "X"
  78.    EXIT cons
  79.   CASE "?"
  80.    GOSUB Help
  81.   CASE "MOVER" 
  82.    GOSUB Mover
  83.   CASE "SELF" 
  84.    GOSUB SelFace
  85.   CASE "FLIP" 
  86.    GOSUB Flip
  87.   CASE "EXG"
  88.    GOSUB Exg
  89.   CASE "NORM"
  90.    GOSUB Norm
  91.   CASE "CENTON"
  92.    GOSUB CenterOn
  93.   CASE "TEXPB"
  94.    GOSUB TexturePosBorder
  95.   CASE "TEXPI"
  96.    GOSUB TexturePosGfxInput
  97.   CASE "TEXMP"
  98.    GOSUB TexturePlaneMap
  99.   CASE "TEXLOAD"
  100.    GOSUB TextureLoad
  101.   CASE "TEXSHOW"
  102.    GOSUB TextureShow
  103.   CASE "CURTEX"
  104.    CurTexture=VAL(PA$(1))
  105.   CASE "OFFS"
  106.    GOSUB Offset
  107.   CASE ELSE
  108.    PRINT "Unknow."
  109.  END SELECT
  110. END REPEAT cons
  111. CALL SaveMETA(METAIN$)
  112. WINDOW CLOSE 2
  113. WINDOW CLOSE 1
  114. SCREEN CLOSE 1
  115. END
  116.  
  117. TextureShow:
  118. GOSUB TextureLoadImage
  119. SCREEN 2,320,320,8,1
  120. T$=Num$(CurTexture)+":"+Tex$(CurTexture,TEXNAME%)+" X,Y:"+Num$(Tex(CurTexture,TEXSIZEX%))+"x"+Num$(Tex(CurTexture,TEXSIZEY%))+" Mem:"+Num$(Tex(CurTexture,TEXSIZEX%)*Tex(CurTexture,TEXSIZEY%))
  121. WINDOW 3,T$,,8,2
  122. WINDOW OUTPUT 3
  123. CALL LoadPalette(Tex$(CurTexture,TEXPALETTE%),2)
  124. xa=(WINDOW(2)-Tex(CurTexture,TEXSIZEX%))/2
  125. ya=(WINDOW(3)-Tex(CurTexture,TEXSIZEY%))/2
  126. txpx!=1
  127. FOR i=1 TO Tex(CurTexture,TEXSIZEY%)
  128.  FOR j=1 TO Tex(CurTexture,TEXSIZEX%)
  129.   PSET (j,i),ASC(MID$(Tex$(CurTexture,TEXIMAGE%),txpx!,1))
  130.   txpx!=txpx!+1
  131.   IF INKEY$<>"" THEN GOTO TS_X
  132.  NEXT j
  133. NEXT i
  134. TS_X:
  135. a$=WAITKEY$
  136. WINDOW CLOSE 3
  137. SCREEN CLOSE 2
  138. RETURN
  139.  
  140. TextureLoadImage:
  141. IF FEXISTS(Tex$(CurTexture,TEXFILE%))
  142.  OPEN Tex$(CurTexture,TEXFILE%) FOR INPUT AS 1
  143.  texsize=LOF(1)
  144.  Tex$(CurTexture,TEXIMAGE%)=INPUT$(texsize,1)
  145.  Tex(CurTexture,TEXSIZEX%)=INT(texsize^.5)
  146.  Tex(CurTexture,TEXSIZEY%)=INT(texsize^.5)
  147. END IF
  148. RETURN
  149.  
  150. TextureLoad:
  151. NTEX=NTEX+1
  152. CurTexture=NTEX
  153. Tex$(CurTexture,TEXFILE%)=FileReq$("Escapelevels:","Select a chunky image","#?")
  154. Tex$(CurTexture,TEXPALETTE%)=FileReq$("Escapelevels:","Select his palette","#?")
  155. GOSUB TextureLoadImage
  156. Tex(CurTexture,USED%)=LOADED%
  157. GOSUB TextureShow
  158. RETURN
  159.  
  160. TextureBWShow:
  161. GOSUB TextureLoadImage
  162. wid=Tex(CurTexture,TEXSIZEX%)
  163. hei=Tex(CurTexture,TEXSIZEY%)
  164. WINDOW 3,"Select points",(0,0)-(wid,hei+32),0,1
  165. xa=0
  166. ya=0
  167. xb=xa+wid
  168. yb=ya+hei
  169. LINE (xa,ya)-(xb,yb),1,bf
  170. LINE (xa,ya)-(xb,yb),2,b
  171. FOR y=0 TO hei-1 STEP 1
  172.  FOR x=0 TO wid-1 STEP 2
  173.   a!=x+y*wid+1
  174.   PSET (x,y),ASC(MID$(Tex$(CurTexture,TEXIMAGE%),a!,1))
  175.  NEXT x
  176. NEXT y
  177. RETURN
  178.  
  179. TexturePlaneMap:        ' I,J,[A/S]
  180. PA$(1)=UCASE$(PA$(1)):a$=PA$(1)
  181. SELECT CASE a$
  182.  CASE "X"
  183.   IOF%=DOTX%
  184.  CASE "Y"
  185.   IOF%=DOTY%
  186.  CASE "Z"
  187.   IOF%=DOTZ%
  188.  CASE ELSE
  189.   IOF%=DOTX%
  190. END SELECT
  191. PA$(2)=UCASE$(PA$(2)):a$=PA$(2)
  192. SELECT CASE a$
  193.  CASE "X"
  194.   JOF%=DOTX%
  195.  CASE "Y"
  196.   JOF%=DOTY%
  197.  CASE "Z"
  198.   JOF%=DOTZ%
  199.  CASE ELSE
  200.   JOF%=DOTZ%
  201. END SELECT
  202. PA$(3)=UCASE$(PA$(3))
  203. IF PA$(3)<>"A" THEN PA$(3)="S"
  204.  
  205. GOSUB TextureBWShow
  206. MINI=Dot(1,IOF%)
  207. MAXI=MINI
  208. MINJ=Dot(1,JOF%)
  209. MAXJ=MINJ
  210. FOR i=1 TO NDOT
  211.  II=Dot(i,IOF%)
  212.  JJ=Dot(i,JOF%)
  213.  IF II<MINI THEN MINI=II
  214.  IF II>MAXI THEN MAXI=II
  215.  IF JJ<MINJ THEN MINJ=JJ
  216.  IF JJ>MAXJ THEN MAXJ=JJ
  217. NEXT i
  218. DEI=MAXI-MINI
  219. DEJ=MAXJ-MINJ
  220. GOSUB TGI_HavePoint:RXA=TX:RYA=TY
  221. GOSUB TGI_HavePoint:RXB=TX:RYB=TY
  222. RWI=RXB-RXA
  223. RHE=RYB-RYA
  224. FOR i=1 TO NFAC
  225.  IP=Dot(Face(i,FACPA%),IOF%)
  226.  JP=Dot(Face(i,FACPA%),JOF%)
  227.  GOSUB TPM_DoDot
  228.  PXA%=TX:PYA%=TY
  229.  IP=Dot(Face(i,FACPB%),IOF%)
  230.  JP=Dot(Face(i,FACPB%),JOF%)
  231.  GOSUB TPM_DoDot
  232.  PXB%=TX:PYB%=TY
  233.  IP=Dot(Face(i,FACPC%),IOF%)
  234.  JP=Dot(Face(i,FACPC%),JOF%)
  235.  GOSUB TPM_DoDot
  236.  PXC%=TX:PYC%=TY 
  237.  LINE (xa+PXA%,ya+PYA%)-(xa+PXB%,ya+PYB%),2
  238.  LINE (xa+PXC%,ya+PYC%)-(xa+PXB%,ya+PYB%),2
  239.  LINE (xa+PXA%,ya+PYA%)-(xa+PXC%,ya+PYC%),2
  240.  CUR$="N"
  241.  IF PA$(3)="S"
  242.   CurFace=i
  243.   GOSUB Refresh
  244.   WINDOW OUTPUT 3
  245.   LOCATE hei/8+2,1
  246.   INPUT "Y/n ";CUR$
  247.   CUR$=UCASE$(CUR$)
  248.  END IF
  249.  IF PA$(3)="A" OR CUR$<>"N"
  250.   Face(i,FACTXA%)=PXA%
  251.   Face(i,FACTYA%)=PYA%
  252.   Face(i,FACTXB%)=PXB%
  253.   Face(i,FACTYB%)=PYB%
  254.   Face(i,FACTXC%)=PXC%
  255.   Face(i,FACTYC%)=PYC%
  256.  END IF
  257. NEXT i 
  258. WINDOW CLOSE 3
  259. RETURN
  260.  
  261. TPM_DoDot:
  262. TX=RXA+((IP-MINI)*RWI/DEI)
  263. TY=RYA+((JP-MINJ)*RHE/DEJ)
  264. RETURN
  265.  
  266. TGI_HavePoint:
  267. LOCATE hei/8+2,1:CALL WAITHIT:B=MOUSE(0):TX=MOUSE(1):TY=MOUSE(2)
  268. RETURN
  269.  
  270.  
  271. TexturePosGfxInput:
  272. GOSUB TextureBWShow
  273. WINDOW OUTPUT 3
  274. GOSUB TGI_HavePoint:PXA%=TX:PYA%=TY
  275. GOSUB TGI_HavePoint:PXB%=TX:PYB%=TY
  276. LINE (xa+PXA%,ya+PYA%)-(xa+PXB%,ya+PYB%),3
  277. GOSUB TGI_HavePoint:PXC%=TX:PYC%=TY
  278. LINE (xa+PXC%,ya+PYC%)-(xa+PXB%,ya+PYB%),3
  279. LINE (xa+PXA%,ya+PYA%)-(xa+PXC%,ya+PYC%),3
  280. Face(CurFace,FACTXA%)=PXA%
  281. Face(CurFace,FACTYA%)=PYA%
  282. Face(CurFace,FACTXB%)=PXB%
  283. Face(CurFace,FACTYB%)=PYB%
  284. Face(CurFace,FACTXC%)=PXC%
  285. Face(CurFace,FACTYC%)=PYC%
  286. WINDOW CLOSE 3
  287. WINDOW OUTPUT 2
  288. RETURN
  289.  
  290. TexturePosBorder:
  291. PA$(1)=UCASE$(PA$(1))
  292. S$=PA$(1)
  293. SELECT CASE S$
  294.  CASE "AB" 
  295.   TXI%=FACTXA%:TYI%=FACTYA%:TXF%=FACTXB%:TYF%=FACTYB%:TXM%=FACTXC%:TYM%=FACTYC%
  296.  CASE "BA"
  297.   TXI%=FACTXB%:TYI%=FACTYB%:TXF%=FACTXA%:TYF%=FACTYA%:TXM%=FACTXC%:TYM%=FACTYC%
  298.  CASE "AC"
  299.   TXI%=FACTXA%:TYI%=FACTYA%:TXF%=FACTXC%:TYF%=FACTYC%:TXM%=FACTXB%:TYM%=FACTYB%
  300.  CASE "CA"
  301.   TXI%=FACTXC%:TYI%=FACTYC%:TXF%=FACTXA%:TYF%=FACTYA%:TXM%=FACTXB%:TYM%=FACTYB%
  302.  CASE "BC"
  303.   TXI%=FACTXB%:TYI%=FACTYB%:TXF%=FACTXC%:TYF%=FACTYC%:TXM%=FACTXA%:TYM%=FACTYA%
  304.  CASE "CB"
  305.   TXI%=FACTXC%:TYI%=FACTYC%:TXF%=FACTXB%:TYF%=FACTYB%:TXM%=FACTXA%:TYM%=FACTYA%
  306.  CASE ELSE
  307.   TXI%=FACTXA%:TYI%=FACTYA%:TXF%=FACTXB%:TYF%=FACTYB%:TXM%=FACTXC%:TYM%=FACTYC%
  308. END SELECT
  309. PA$(2)=UCASE$(PA$(2))
  310. S$=PA$(2)
  311. SELECT CASE S$
  312.  CASE "T"
  313.   PXA%=0:PYA%=0:PXB%=Tex(CurTexture,TEXSIZEX%):PYB%=PYA%
  314.   PXC%=VAL(PA$(3)):PYC%=Tex(CurTexture,TEXSIZEY%)
  315.  CASE "B"
  316.   PXA%=0:PYA%=Tex(CurTexture,TEXSIZEY%):PXB%=Tex(CurTexture,TEXSIZEX%):PYB%=PYA%
  317.   PXC%=VAL(PA$(3)):PYC%=0
  318.  CASE "R"
  319.   PXA%=Tex(CurTexture,TEXSIZEX%):PYA%=Tex(CurTexture,TEXSIZEY%):PXB%=PXA%:PYB%=0
  320.   PXC%=0:PYC%=VAL(PA$(3))
  321.  CASE "L"
  322.   PXA%=0:PYA%=Tex(CurTexture,SIZEY%):PXB%=0:PYB%=0
  323.   PYC%=VAL(PA$(3)):PXC%=Tex(CurTexture,TEXSIZEX%)
  324. END SELECT
  325. Face(CurFace,TXI%)=PXA%
  326. Face(CurFace,TYI%)=PYA%
  327. Face(CurFace,TXF%)=PXB%
  328. Face(CurFace,TYF%)=PYB%
  329. Face(CurFace,TXM%)=PXC%
  330. Face(CurFace,TYM%)=PYC%
  331. RETURN
  332.  
  333. CenterOn:
  334. CP=VAL(PA$(1))
  335. IF Dot(CP,USED%)<>0
  336.  XP=Dot(CP,DOTX%)
  337.  YP=Dot(CP,DOTY%)
  338.  ZP=Dot(CP,DOTZ%)
  339.  GOSUB Offsettize
  340. END IF 
  341. GOSUB Refresh
  342. RETURN
  343.  
  344. Offset:
  345. XP=VAL(PA$(1))
  346. YP=VAL(PA$(2))
  347. ZP=VAL(PA$(3))
  348. Offsettize:
  349. FOR i=1 TO NDOT
  350.  Dot(i,DOTX%)=Dot(i,DOTX%)-XP
  351.  Dot(i,DOTY%)=Dot(i,DOTY%)-YP
  352.  Dot(i,DOTZ%)=Dot(i,DOTZ%)-ZP
  353. NEXT i
  354. ObjRef(REF_X%+REF_O%)=ObjRef(REF_X%+REF_O%)-XP
  355. ObjRef(REF_Y%+REF_O%)=ObjRef(REF_Y%+REF_O%)-YP
  356. ObjRef(REF_Z%+REF_O%)=ObjRef(REF_Z%+REF_O%)-ZP
  357. RETURN
  358.  
  359. Flip:
  360. PA$(1)=UCASE$(PA$(1))
  361. IF Contain("X",PA$(1)) THEN MX=-1 ELSE MX=1
  362. IF Contain("Y",PA$(1)) THEN MY=-1 ELSE MY=1
  363. IF Contain("Z",PA$(1)) THEN MZ=-1 ELSE MZ=1
  364. FOR